Preditor de Cliques em Anúncios
Neste projeto será feito uma análise exploratória de um conjunto de dados de uma empresa de publicidade, que contém o histórico de acesso dos clientes ao site, com o intuito de saber se um cliente clicou ou não em um anúncio do site. Será criado um modelo que prevê se o cliente clicará ou não em um anúncio, baseado nos dados e histórico dos registros anteriores.
Importação dos pacotes necessários e do dataset.
library(tidyverse)
library(car)
library(psych)
library(DescTools)
library(plotly)
library(lubridate)
df <- read_csv("advertising.csv")Visão Geral do dataset importado, e informações adicionais
df %>% head(3) %>% knitr::kable(align = "llllllll")| Daily Time Spent on Site | Age | Area Income | City | Male | Country | Timestamp | Clicked on Ad |
|---|---|---|---|---|---|---|---|
| 68.95 | 35 | 61833.90 | Wrightburgh | 0 | Tunisia | 2016-03-27 00:53:11 | 0 |
| 80.23 | 31 | 68441.85 | West Jodi | 1 | Nauru | 2016-04-04 01:39:02 | 0 |
| 69.47 | 26 | 59785.94 | Davidton | 0 | San Marino | 2016-03-13 20:35:42 | 0 |
df %>% str## spec_tbl_df [1,000 × 8] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ Daily Time Spent on Site: num [1:1000] 69 80.2 69.5 74.2 68.4 ...
## $ Age : num [1:1000] 35 31 26 29 35 23 33 48 30 20 ...
## $ Area Income : num [1:1000] 61834 68442 59786 54806 73890 ...
## $ City : chr [1:1000] "Wrightburgh" "West Jodi" "Davidton" "West Terrifurt" ...
## $ Male : num [1:1000] 0 1 0 1 0 1 0 1 1 1 ...
## $ Country : chr [1:1000] "Tunisia" "Nauru" "San Marino" "Italy" ...
## $ Timestamp : POSIXct[1:1000], format: "2016-03-27 00:53:11" "2016-04-04 01:39:02" ...
## $ Clicked on Ad : num [1:1000] 0 0 0 0 0 0 0 1 0 0 ...
## - attr(*, "spec")=
## .. cols(
## .. `Daily Time Spent on Site` = col_double(),
## .. Age = col_double(),
## .. `Area Income` = col_double(),
## .. City = col_character(),
## .. Male = col_double(),
## .. Country = col_character(),
## .. Timestamp = col_datetime(format = ""),
## .. `Clicked on Ad` = col_double()
## .. )
Renomeando e alterando os tipos das variáveis
colnames(df) <- c('minutos diarios no site', 'idade', 'renda anual', 'cidade do cliente', 'sexo', 'nacionalidade',
'horario que saiu do site', 'clicou no anuncio')
df$sexo <- as_factor(df$sexo) %>% lvls_revalue(c("feminino","masculino")) %>% relevel(ref = "masculino")
df$`horario que saiu do site` <- as.character(df$`horario que saiu do site`) %>% ymd_hms()
df$`clicou no anuncio` <- as_factor(df$`clicou no anuncio`) %>% lvls_revalue(c("nao","sim"))
df %>% head(3) %>% knitr::kable(align = "llllllll")| minutos diarios no site | idade | renda anual | cidade do cliente | sexo | nacionalidade | horario que saiu do site | clicou no anuncio |
|---|---|---|---|---|---|---|---|
| 68.95 | 35 | 61833.90 | Wrightburgh | feminino | Tunisia | 2016-03-27 00:53:11 | nao |
| 80.23 | 31 | 68441.85 | West Jodi | masculino | Nauru | 2016-04-04 01:39:02 | nao |
| 69.47 | 26 | 59785.94 | Davidton | feminino | San Marino | 2016-03-13 20:35:42 | nao |
Verificando correlação entre as variáveis
Com isso, podemos ter uma ideia das variáveis mais importantes para análise e para o modelo preditivo.
pairs.panels(df[,c(8,1,2,3,5,7)])OBS: É possivel notar que há 75% de correlação entre clicou no anuncio e minutos no site
Há 49% de correlação entre clicou no anuncio e idade.
48% de correlação entre clicou no anuncio e renda anual.
Também é possivel notar que sexo e horário em que saiu do site tem pouquíssima correlação não so com clicou no anuncio mas também com todas as outras variáveis.
Visualizando a distribuição de idade dos clientes
plot_ly(data = df, x=~idade, type = "histogram")OBS: A maioria dos clientes estão na faixa dos 28 aos 40 anos
Visualizando quem clicou baseado na renda dos clientes e na idade
plot_ly( data = df, x=~`renda anual`, y=~idade, type = "scatter", color = ~`clicou no anuncio`, colors="Set1" )OBS: É nítido que quanto maior a renda do cliente, menos interesse em anúncios, também é possível notar que as pessoas mais velhas e com uma renda menor, são as que mais clicam em anúncios.
Confirmando ausência de correlação significativa da variável sexo
Verificando média de minutos que o cliente passa no site por sexo
df %>% group_by(sexo) %>% summarise("minutos diarios"=mean(`minutos diarios no site`), "idade"=mean(idade)) %>% knitr::kable(align = "lll", digits = 2)| sexo | minutos diarios | idade |
|---|---|---|
| masculino | 64.69 | 35.82 |
| feminino | 65.29 | 36.19 |
OBS: Como esperado, não há tendência relevante, o sexo n tem significância em quem passa mais tempo no site, e nem na idade dos clientes
Gráfico representativo
plot_ly(data=df, x=~`minutos diarios no site`, y=~idade, type = "scatter", color = ~sexo, colors = c("mediumvioletred","forestgreen"))OBS: Dados espalhados sem nenhum padrão, o que confirma que a variável sexo não tem significância para o modelo preditivo.
Criando modelo
O conjunto será particionado em dois, uma parte com 80% dos dados para treinar o modelo, e outra com 20% para testar o desempenho.
Como foi confirmado no gráfico de correlação que as únicas variáveis preditoras significantes para o modelo são minutos diarios no site, renda anual e idade , será criado modelos com estas variáveis.
Modelo 1: minutos diarios no site, renda anual e idade.
Modelo 2: minutos diarios no site e renda anual.
Modelo 3: apenas com minutos diarios no site.
indexTreino <- sample( 1:nrow(df), round(nrow(df) * 0.8) )
dfTreino <- df[indexTreino,] %>% select(`minutos diarios no site`, `renda anual`, `idade`, `clicou no anuncio`)
dfTeste <- df[-indexTreino,] %>% select(`minutos diarios no site`, `renda anual`, `idade`, `clicou no anuncio`)
modelo1 <- glm(data = dfTreino, family = binomial(), formula = `clicou no anuncio` ~ `minutos diarios no site` + `renda anual` + idade)
modelo2 <- glm(data = dfTreino, family = binomial(), formula = `clicou no anuncio` ~ `minutos diarios no site` + `renda anual`)
modelo3 <- glm(data = dfTreino, family = binomial(), formula = `clicou no anuncio` ~ `minutos diarios no site`)Verificando desepenho dos modelos
Será utilizado a métrica AIC e BIC para comparar desempenho dos 3 modelos, quanto menor o valor retornado por essas métricas, melhor o modelo.
list( AIC(modelo1, modelo2, modelo3), BIC(modelo1, modelo2, modelo3) ) %>% knitr::kable(align = "ll")
|
|
OBS: Em ambas as métricas o modelo1 teve o melhor resultado.
Analisando coeficientes do melhor modelo
coef(modelo1)## (Intercept) `minutos diarios no site` `renda anual`
## 15.5626968800 -0.2071604021 -0.0001215762
## idade
## 0.1543718837
OBS: minutos diarios no site e renda anual influenciam negativamente em quem clica no anuncio, ou seja, quanto maior a renda ou o tempo que o cliente navega no site, maior a chance dele NÃO clicar nos anúncios, já a idade influencia de forma positiva, portanto, quanto mais velho o indivíduo, maior as chances do mesmo clicar em anúncios.
Verificando o quanto as variaveis preditoras explicam os resultados dos cliques
Será utilizada a métrica do pseudo R quadrado, que dá a porcentagem do quanto as variáveis preditoras escolhidas explicam a variável a ser predita.
PseudoR2(modelo1, which = "Nagelkerke")## Nagelkerke
## 0.8490473
OBS: As variáveis escolhidas explicam aproximadamente 80% dos resultados dos cliques em anúncios.
Verificando Outliers
Será verificado os valores dos resíduos padronizados, para identificar outliers, o resultado dos resíduos padronizados devem ser maiores que 2, ou menores que -2
dfTreino$N <- 1:nrow(dfTreino)
dfTreino$residuo_padronizado <- rstandard(modelo1)
plot_ly(data = dfTreino, x=~N, y=~residuo_padronizado, marker=list(color="darkgreen"))OBS: Podemos ver que alguns indivíduos são possíveis outliers
Verificando Pontos influentes
Antes de removermos os outliers, será verificado se estes influenciam de forma positiva no modelo, que seriam pontos influentes, para identificar estes individuos, será utilizado a métrica Distância de Cook.
É considerado um ponto influente, indivíduos com o valor da distância de cook próximo, igual ou maior que 1.
dfTreino$DistanciaCook <- cooks.distance(modelo1)
plot_ly(dfTreino, y=~DistanciaCook, x=~N, type = "scatter", marker=list(color="darkmagenta"))OBS: Apesar de alguns indivíduos conterem o valor da distância de cook maior que o restante, não é o bastante para ser considerado um ponto influente
Removendo Outliers do dataset
será removido todo individuo que contenha residuos padronizados com valores maiores que 2 e menores que -2.
outliers <- filter(dfTreino, residuo_padronizado >= 2 | residuo_padronizado <= -2)$N
dfSemOutlier <- dfTreino[-outliers,]Conferindo alteração
Resíduos padronizados sem outliers
plot_ly(data = dfSemOutlier, x=~N, y=~residuo_padronizado, marker=list(color="darkgreen"))OBS: Agora com todos os resíduos padronizados menores que 2, e maiores que -2
Resíduos padronizados com outliers
plot_ly(data = dfTreino, x=~N, y=~residuo_padronizado, marker=list(color="darkgreen"))Gerando o novo modelo sem os Outliers
modeloFinal <- glm(data = dfSemOutlier, family = binomial(), formula = `clicou no anuncio` ~ `minutos diarios no site` + `renda anual` + idade)Comparando o novo modelo com o modelo 1
list( AIC(modeloFinal, modelo1), BIC(modeloFinal, modelo1) ) %>% knitr::kable()
|
|
OBS: Como podemos ver, o modelo final teve um resultado superior
Verificando o quanto as variáveis explicam os dados
Novamente será utilizada a métrica do pseudo R quadrado, so que comparando o modelo final com o modelo 1
Modelo final
modeloFinal %>% PseudoR2(which = "Nagelkerke")## Nagelkerke
## 0.9270439
OBS: É notavel que agora sem outliers, aproximadamente 90% dos dados são explicados pelas variáveis, invés dos 80% do modelo com outliers
Modelo 1
modelo1 %>% PseudoR2(which = "Nagelkerke")## Nagelkerke
## 0.8490473
Testando o modelo
Antes do teste, será feito o teste de multicolinearidade.
Multicolinearidade é quando há uma correlação muito forte entre variáveis preditoras, o que pode ser prejudicial na eficácia do modelo, é considerado caso de multicolinearidade quando a correlação entre as variáveis preditoras ultrapassam dos 0.8(80%).
pairs.panels(dfTreino %>% select(`renda anual`, `minutos diarios no site`, idade))OBS: Como podemos ver, não há multicolinearidade entre as variáveis preditoras
Resultado das predições
Será aplicado a partição que representa 20% do dataset, para avaliar como que o modelo reage com dados que ele nunca viu.
Será gerado um gráfico de dispersão, que irá comparar os dados reais do conjunto de testes com as predições do modelo, ou seja, irá comparar o que realmente aconteceu, com o que o modelo preveu, colorindo de tom esverdeado os dados reais do conjunto teste que são individuos que CLICARAM em anúncios, e colorindo de tom avermelhado os dados reais do conjunto de teste que NÃO CLICARAM nos anúncios.
A numeração entre 0 a 100, equivale a porcentagem de chance de um indivíduo clicar nos anúncios, esta numeração nada mais é que o resultado da predição do modelo final.
Então, basicamente, quanto mais dados esverdeados(clicaram) no topo da porcentagem, e quanto mais dados avermelhados(não clicaram) no fundo, melhor desempenho de acerto o modelo tem na prática.
Gráfico representativo
preds <- predict( modeloFinal, select(dfTeste, -`clicou no anuncio`), type = "response" )
predicoes <- tibble(N=1:nrow(dfTeste), "Clicou no anuncio"=dfTeste$`clicou no anuncio`, "Predicao"=round(preds*100,1) )
plot_ly(data = predicoes, y=~Predicao, x=~N, color=~`Clicou no anuncio`, type = "scatter", colors = c("firebrick","olivedrab"))OBS: Podemos ver que a grande maioria dos individuos dos dados reais que clicaram(verdes), o modelo sugeriu uma % alta para chance do clique, e também sugeriu uma % baixa para a grande maioria dos individuos que realmente não clicaram(vermelhos) em anúncios.
Dataset da % de predições
predicoes$Predicao <- str_c( predicoes$Predicao, "%" )
predicoes[,-1] %>% head %>% knitr::kable(align = "ll")| Clicou no anuncio | Predicao |
|---|---|
| nao | 4.2% |
| nao | 0.1% |
| sim | 100% |
| sim | 99.4% |
| nao | 0.1% |
| sim | 100% |